perm filename FUNCS.FAI[MUS,LCS] blob sn#365820 filedate 1978-01-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE FUNCS
C00012 ENDMK
C⊗;
	TITLE FUNCS
	ENTRY SEE  ;FUNCTION SEE(ARRAY)
	ENTRY SEG  ;FUNCTION SEG(ARRAY FUNC);
	ENTRY SYNTH  ;FUNCTION SYNTH(ARRAY FUNC);
	EXTERNAL RDNUM, DPYSET,ALINE,DPYOUT,DDCLR,TYPLOC
	EXTERNAL RVECT,AIVECT,ZERO,SIND
SEG:	0	;BEGIN
;;	HRRZI 15,FSTSAV
;;	BLT 15,FSTSAV+14		;SAVES ACS 0→14
;;;;	JSA 16,DDCLR   ;VARIABLE X512,K,A1,A2,ST,STPP,STPS,IS,IT,DIF,RK;
	SETZ 4,		;A1    A1←0; ST←0; STPP←0; X512←0;
	SETZ 2,		;ST
	MOVE 10,[999.0]
	SETZ 3,		;STPP
	SETZ 1,		;X512
	SETZM STPP#
SEG1:	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP A2#	;WHILE STPP ≤ 1 DO  BEGIN   RDNUM(A2);  
	PUSHJ 17,RETAC
	MOVE 5,A2	;		 IF A2 =512 THEN X512←A2;
	CAME 5,[512.0]
	JRST SEG2	;1 SERVES AS X512
	MOVN 1,5 	; X512 IS NOW NEG.
	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP A2 ; IF A2 =512 THEN RDNUM(A2);  RDNUM(STPP);
	SKIPA         
;COMMENT: TYPE 512 AT FIRST TO USE 512 STEPS INSTEAD OF 100 STEPS.;
SEG2:	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP STPP#
	PUSHJ 17,RETAC
	MOVE 3,STPP
	CAMLE 3,[1.0]  ; IF STPP ≤ 1 THEN A1←A2;
	JRST SEG3
	MOVE 4,A2
	JRST SEG1		;  END;

SEG3:	JUMPL 1,SEG4    ;    WHILE STPP < 999 DO   BEGIN  
	MOVE 13,[5.12]  ;IS← INT(STPP*5.120+.0001);
	FMPR 13,3
	FADR 13,[0.0001]
	JRST SEG5; IF X512 > 0 THEN IS←INT(STPP+.0001);
SEG4:	MOVE 13,[0.0001]
	FADR 13,3
SEG5:	KIFIX 13,13	;13 IS "IS"
	CAIG 13,=512	; IF IS > 512 THEN 
	JRST SEG6	; (NOT SMOOTHED)
	OUTSTR[ASCIZ/ *** SMOOTHED /]  ;    BEGIN   PRINT " *** SMOOTHED ";
	MOVEI 6,=511  ;	FOR K←0 STEP 1 UNTIL 511 DO
	MOVE 7,(16)
;COMMENT: READ 512 NUMS FROM A FUNC FILE.;
SEG7:	PUSHJ 17,SAVAC
	JSA 16,RDNUM  ;		  BEGIN
	JUMP RK#    ;	     RDNUM(RK);  FUNC(K)← RK;
	PUSHJ 17,RETAC
	MOVE RK
	MOVEM (7)
	AOJ 7,		;  END;
	SOJGE 6,SEG7
SEGEND:	OUTSTR [ASCIZ/SEG ARRAY   /]  ;   SEEIT(FUNC); PRINT "SEG ARRAY   "; 
;FUNCTION NOTDD  --  IF AC0 NEG. IT'S NOT A DATADISC -- FOR 'SEE'
NOTDD:	MOVNI	2,1
	GETLIN	2	;0=IT IS A DD
	TLNN	2,20000
	PUSHJ 17,SHOW    ;	SETO	;-1=NOT DD
;;	HRLZI 15,FSTSAV
;;	BLT 15,15		;RETRIEVES ACS 
	JRA 16,1(16)  ;	RETURN;	    END;

SEG6:	SOJ 13,	;	STPP ← IS-1; 		STPS ← STPP-ST;
	FLTR 3,13
	MOVE 6,3	;(6=STPS, 3=STP)
	FSBR 6,2 	; -ST 	IS ← INT(STPS);		DIF←A2-A1;
	KIFIX 13,6	; 0=IS
	MOVE 10,A2
	FSBR 10,4	;	IT←INT(ST);		ST ← STPP;
	KIFIX 11,2	; 2=IT  	FOR K←0 STEP 1 UNTIL IS DO
	MOVE 2,3	;		BEGIN
	SETZ 7,		;		RK ← K;
	MOVE 12,(16)	;		FUNC(K+IT)  ← A1+DIF*RK/STPS; 
	ADD 12,11	;	END;
;;	MOVE 14,4
;;	FADR 14,10	;	IF STPP = 511 THEN BEGIN 
SEG8:	FLTR 15,7	;	    SEEIT(FUNC);PRINT "SEG ARRAY   "; END;
	FDVR 15,6	;	IF STPP ≥ 511 THEN RETURN;
	FMPR 15,10	;	A1←A2;  ST←STPP;
	FADR 15,4	; (+A1)
	MOVEM 15,(12)	;	RDNUM(A2); RDNUM(STPP);
	AOJ 12,		;       END;
	AOJ 7,		;END;
	CAMG 7,13		;CAMG K,IS
	JRST SEG8
	CAML 3,[511.0]
	JRST SEGEND		;ALL DONE
	MOVE 4,A2	; 4 IS A1
	MOVE 6,3	;6 IS ST, 3 IS STPP
	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP A2  
	JSA 16,RDNUM
	JUMP STPP
	PUSHJ 17,RETAC
	MOVE 3,STPP
	JRST SEG3

SYNTH:	0
;;	HRRZI 15,FSTSAV
;;	BLT 15,FSTSAV+14
	MOVE 1,(16)
	MOVEM 1,SY
	JSA 16,ZERO	;ZERO OUT THE ARRAY
SY:	0
	JSA 16,RDNUM
	JUMP STPP	;XX AND H
	MOVE 13,STPP
	CAMN 13,[99.0]
	SETO 13,
	MOVEM 13,STPP		; H LATER
	MOVE 10,[999.0]
	JUMPGE 13,SY2
	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP STPP	;THIS IS H
	PUSHJ 17,RETAC
SY2:	CAMG 10,STPP
	JRST SYNEND
	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP A2		;A2 IS AMP
	PUSHJ 17,RETAC
	SETZ 3,		;X
	SETZ 4,		;CON
	JUMPGE 13,SY3
	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP SY		;SY WILL BE X
	JSA 16,RDNUM
	JUMP CON#
	PUSHJ 17,RETAC
	MOVE 3,SY	;X
	MOVE 4,CON
	FMPR 3,[1.422222]
	FADR 3,[1.0]
SY3:	MOVEI 6,=511
	MOVE 1,(16)
SY4:	MOVE 5,3 
	FMPR 5,[0.703125]
	MOVEM 5,RK	;XX
	PUSHJ 17,SAVAC
	JSA 16,SIND
	JUMP RK
	PUSHJ 17,RETAC
SYX:	FMPR 0,A2	;AMP
	FADR 0,4	;+CON
	CAMGE 4,[100.0]
	JRST SY5
;;	MOVN 7,[100.0]
;;	FADR 7,0
;;	FMPRM 7,(1)
	FSBR 0,[100.0]
	FMPRM 0,(1)
	SKIPA
SY5:	FADRM 0,(1)
;;	MOVE 5,2	;H
	FADR 3,STPP	; X←X+H
	CAMLE 3,[512.0]
	FSBR 3,[512.0]
	AOJ 1,
	SOJGE 6,SY4
	PUSHJ 17,SAVAC
	JSA 16,RDNUM
	JUMP STPP		;H
	PUSHJ 17,RETAC
	JRST SY2
SYNEND:	MOVE 1,(16)
	MOVE 5,(1)
	MOVEI 6,=511
SY6:	MOVM 2,(1)
	CAMGE 5,2
	MOVE 5,2
	AOJ 1,
	SOJGE 6,SY6
	MOVEI 6,=511
	MOVE 1,(16)
SY7:	MOVE 0,(1)
	FDVR 0,5
	MOVEM 0,(1)
	AOJ 1,
	SOJGE 6,SY7
	OUTSTR [ASCIZ/ SYNTH ARRAY   /]
	JRST NOTDD

SAVAC:	MOVE  15,[1,,ACSAV]
	BLT 15,ACSAV+13		;SAVES ACS 1→14
	POPJ 17,
RETAC:	MOVE  15,[ACSAV,,1]
	BLT 15,13		;RETRIEVES THEM
	POPJ 17,
DPY:	BLOCK =250		;DISPLAY BUFFER
ACSAV:	BLOCK 13
FSTSAV:	BLOCK 13
 
SHOW:	JSA 16,DDCLR
	JSA 16,DPYSET ↔	JUMP [2]↔ JUMP DPY↔	JUMP [=263]
	JSA 16,TYPLOC↔	JUMP [-=100]↔	JUMP [-=412]
	JSA 16,ALINE↔	JUMP [-=264]↔	JUMP [=200]
	JUMP [=256] ↔	JUMP [=200]
	JSA 16,ALINE ↔	JUMP [-=266] ↔	JUMP [=328]
	JUMP [-=246] ↔	JUMP [=328]
	JSA 16,ALINE ↔	JUMP [-=266] ↔	JUMP [=456]
	JUMP [-=246] ↔	JUMP [=456]
	JSA 16,ALINE ↔	JUMP [-=266] ↔	JUMP [=72]
	JUMP [-=246] ↔	JUMP [=72]
	JSA 16,ALINE ↔	JUMP [-=266] ↔	JUMP [-=56]
	JUMP [-=246] ↔	JUMP [-=56]
	JSA 16,ALINE ↔	JUMP [-=256] ↔	JUMP [-=56]
	JUMP [-=256] ↔	JUMP [=456]
	JSA 16,ALINE ↔	JUMP [0] ↔	JUMP [=190]
	JUMP [0] ↔	JUMP [=210]
	JSA 16,ALINE ↔	JUMP [-=128] ↔	JUMP [=190]
	JUMP [-=128] ↔	JUMP [=210]
	JSA 16,ALINE ↔	JUMP [=128] ↔	JUMP [=190]
	JUMP [=128] ↔	JUMP [=210]
 
 	MOVE 1,(16)	;FUNC(0)
	MOVE 1,(1)
	FMPR 1,[256.0]
	FADR 1,[200.0]
	KIFIX 1,1
	MOVEM 1,RK	;OLD IY
	JSA 16,AIVECT ↔	JUMP [-=256] ↔	JUMP RK
	MOVEI 2,1
SH1:	MOVEM 2,STPP
	MOVE 3,(16)
	ADD 3,STPP
	MOVE 1,(3)
	FMPR 1,[256.0]
	FADR 1,[200.0]
	KIFIX 1,1	;OLD IY2
	MOVE  2,1 	
	SUB 1,RK
	MOVEM 1,ACSAV
	MOVEM 2,RK	;IY←IY2
	JSA 16,RVECT ↔	JUMP [2] ↔	JUMP ACSAV
	MOVE 2,STPP
	ADDI 2,2	;SEE EVERY 2ND POINT
	CAIG 2,=511
	JRST SH1
	JSA 16,DPYOUT ↔	JUMP [2]
	POPJ 17,

SEE:	0
;;	JSA 16,DDCLR	;CLEAR THE DATADISK SCREEN
	PUSHJ 17,SHOW
	JRA 16,1(16)  ;	RETURN;	    END;

	END